home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / ELECTRON / PCB_DESI / H027.ZIP / TOOLS.EXE / lha / GERBLAYO.PAS < prev    next >
Pascal/Delphi Source File  |  1990-11-21  |  5KB  |  210 lines
  1. program gerblayo;
  2.  
  3. { converteer gerber files naar layo1 .BNK bestand }
  4.  
  5. uses crt,dos;
  6.  
  7. const
  8.   layer : byte = 1;
  9.  
  10. type
  11.   woord80 = string[80];
  12.  
  13.   arrtypint = array[0..32500] of integer;
  14.   arrtypbyt = array[0..32500] of byte;
  15.  
  16. var
  17.   ch : char;
  18.   w1:woord80;
  19.   hoogsteregel : word;
  20.  
  21.   xpositie,
  22.   ypositie : ^arrtypint;
  23.   sympen : ^ arrtypbyt;
  24.  
  25. procedure save_bnk;
  26. type
  27.   lrec = record b,s:byte; x,y:integer; end;
  28. var
  29.   rec : lrec; f1 : file of lrec; i:word;
  30. begin
  31.   w1 := '';
  32.   if paramstr(2) >= '' then assign(f1,paramstr(2)) else
  33.   begin
  34.     write('Type :  destination filename with extension .BNK  ');
  35.     readln(w1);
  36.     assign(f1,w1);
  37.   end;
  38.   {$i-} Rewrite(f1); {$i+}
  39.   i := ioresult;
  40.   if i <> 0 then
  41.   begin
  42.     write('IOERROR ',i,' Progamm aborted...');
  43.     ch := readkey;
  44.     halt;
  45.   end;
  46.   for i:=1 to hoogsteregel do
  47.   begin
  48.     rec.b:= 0;
  49.     rec.s:=sympen^[i];
  50.     rec.x:=xpositie^[i];
  51.     rec.y:=ypositie^[i];
  52.     write(f1,rec);
  53.   end;
  54.   close(f1);
  55. end;
  56.  
  57. procedure init;
  58. var
  59.   i:word;
  60. begin
  61.   hoogsteregel := 0;
  62.   new(xpositie);
  63.   new(ypositie);
  64.   new(sympen);
  65.   for i := 0 to 32500 do
  66.   begin
  67.     xpositie^[i] := 0;
  68.     ypositie^[i] := 0;
  69.     sympen^[i] := 0;
  70.   end;
  71. end;
  72.  
  73. procedure lees_inf;
  74. var
  75.   f1:text;
  76. begin
  77.   clrscr;
  78.   assign(f1,paramstr(1));
  79.   reset(f1);
  80.   while not eof(f1) do
  81.   begin
  82.     readln(f1,w1);
  83.     writeln(w1);
  84.   end;
  85.   close(f1);
  86. end;
  87.  
  88. {
  89. D01* = PEN DOWN
  90. D02* = PEN UP
  91. D03* = FLASH
  92. D10* = PEN 1
  93. D11* = PEN 2
  94. D12* = PEN 3
  95. D13* = PEN 4
  96. D14* = PEN 5
  97. D15* = PEN 6
  98. D17* = PEN 7
  99. D20* = PAD 0
  100. D21* = PAD 7
  101. D
  102.  
  103.  
  104.  
  105. procedure mess(w:woord80);
  106. begin
  107.   writeln(#13#10,w);
  108.   halt;
  109. end;
  110.  
  111.  
  112. procedure load_gerber;
  113. var
  114.   f1:text;
  115.   nummer : char;
  116.   xs,ys,ds : string[20];
  117.   xr,yr:real;
  118.   i,x,y : integer;
  119.   sp : byte;
  120.   pen,pad:word;
  121. begin
  122.   ds := paramstr(3);
  123.   if ds = '' then ds := '1';
  124.   val(ds,layer,i);
  125.   writeln(#10#10#13,'Reading ',paramstr(1));
  126.   assign(f1,paramstr(1));
  127.   {$i-} reset(f1); {$I+}
  128.   if ioresult <> 0 then
  129.   begin
  130.     writeln('File not open...');
  131.     halt;
  132.   end;
  133.   while not eof(f1) do
  134.   begin
  135.     readln(f1,w1);
  136. {    writeln('Gelezen van F1 = ',w1);}
  137.     if length(w1) > 0 then
  138.     begin
  139.       if w1[1] = 'D' then
  140.       begin
  141.         ds := copy(w1,2,pos('*',w1)-2);
  142.         val(ds,sp,i);
  143.         case sp of
  144.           10 : pen :=1;
  145.           11 : begin pen := 2; pad := 0;  end;
  146.           12 : begin pen := 3; pad := 7;  end;
  147.           13 : begin pen := 4; pad := 8;  end;
  148.           14 : begin pen := 5; pad := 9;  end;
  149.           15 : begin pen := 6; pad := 10; end;
  150.           16 : begin pen := 7; pad := 11; end;
  151.           17 : begin pen := 0; pad := 12; end;
  152.           18 : begin pen := 0; pad := 13; end;
  153.           19 : begin pen := 0; pad := 14; end;
  154.           70 : begin pen := 0; pad := 15; end;
  155.           71 : begin pen := 0; pad :=  0; end;
  156.         end;
  157. {        writeln('PEN = ',pen,'  PAD = ',pad); }
  158. {        ch := readkey; }
  159.       end;
  160.       if w1[1] = 'X' then
  161.       begin
  162.         if hoogsteregel < 30000 then inc(hoogsteregel) else mess('full');
  163.         xs := copy(w1,2,pos('Y',w1)-2);
  164.         ys := copy(w1,pos('Y',w1)+1,pos('D',w1) - pos('Y',w1)-1);
  165.         ds := copy(w1,pos('D',w1)+1,pos('*',w1) - pos('D',w1)-1);
  166.  
  167.         if ((xs[1] = '-') or (xs[1] = '+')) and (pos('.',xs) = 0)
  168.         then insert('.',xs,4);
  169.         if ((ys[1] = '-') or (ys[1] = '+')) and (pos('.',ys) = 0)
  170.         then insert('.',ys,4);
  171.         if pos('.',xs) = 0 then insert('.',xs,3);
  172.         if pos('.',ys) = 0 then insert('.',ys,3);
  173. {        writeln(#13#10' XS =',xs,' YS =',ys,' DS =',ds); }
  174.         val(xs,xr,x);
  175.         val(ys,yr,y);
  176.         x := round(xr * 1280);
  177.         y := round(yr * 1280);
  178. {        writeln(hoogsteregel,'  X = ',x,' Y = ',y,' ',ds);}
  179.         xpositie^[hoogsteregel] := x;
  180.         ypositie^[hoogsteregel] := y;
  181.         if ds = '01' then
  182.         sympen^[hoogsteregel] := (layer shl 3) + pen {pd} else
  183.         if ds = '02' then
  184.         sympen^[hoogsteregel] := (layer shl 3)       {pu} else
  185.         if ds = '03' then sympen^[hoogsteregel] := $80 + (pad shl 3);
  186.       end;
  187.     end;
  188.   end;
  189.   close(f1);
  190. end;
  191.  
  192.  
  193. begin
  194.   if paramcount < 2 then
  195.   begin
  196.     clrscr;
  197.     writeln('type   GERBLAYO source destination layer');
  198.     writeln;
  199.     writeln('Example : gerblayo a:\demo.g01 c:\layo1p\demo.bnk');
  200.     writeln;
  201.     halt;
  202.   end;
  203.   init;
  204. {  lees_inf; } {pads + pendiktes}
  205.   load_gerber;
  206.   save_bnk;
  207.   writeln('ok...');
  208. end.
  209.  
  210.